Acts of Regression Project

Aim

The aim of this project is to find what most influences the price of a diamond, and to be able to predict the price of an unseen data set based off the findings.

Load Libraries

library(pROC)
#Displays and analyses ROC curves

library(car)
#A companion to applied regression

library(caTools)
#Moving window statistics, GIFs, and other tools

library(ggplot2)
#Higher level graphing package

library(plotly)

library(ggcorrplot)

library(tidyverse)

Data Sourcing and cleanup

##Import packages required
###install.packages("ggcorrplot")
library(ggcorrplot)
library(tidyverse)
##Looking to load the data set Diamonds (We lacked the data for a business relevent one.)
Diamonds <- read.csv("S:/Business Solutions/ThomasT/Current/data-fellowship/Regression/Diamonds.csv")
##Data cleanup should occur now, however this data has been pre-cleaned to speed up the process.
####Would look for Null or incorrect format values that didnt fit and remove the rows/separate from the data.

Using a Correlograms to identify correlations with price.

##The aim of this part is to use a Correlograms of the entire dataset to work out what attribute most affects the price of a diamond. Will initially have to alter the categoric values to a numeric one.
Diamonds$cut <- as.integer(Diamonds$cut)
Diamonds$color <- as.integer(Diamonds$color)
Diamonds$clarity <- as.integer(Diamonds$clarity)
##Find Correlation between values
cor(Diamonds)

              carat           cut         color     clarity       depth       table       price
carat    1.00000000  0.0171237362  0.2914367543 -0.21429037  0.02822431  0.18161755  0.92159130
cut      0.01712374  1.0000000000  0.0003042479  0.02823537 -0.19424856  0.15032703  0.03986029
color    0.29143675  0.0003042479  1.0000000000 -0.02779550  0.04727923  0.02646520  0.17251093
clarity -0.21429037  0.0282353656 -0.0277954960  1.00000000 -0.05308011 -0.08822266 -0.07153497
depth    0.02822431 -0.1942485626  0.0472792348 -0.05308011  1.00000000 -0.29577852 -0.01064740
table    0.18161755  0.1503270263  0.0264652011 -0.08822266 -0.29577852  1.00000000  0.12713390
price    0.92159130  0.0398602909  0.1725109282 -0.07153497 -0.01064740  0.12713390  1.00000000
x        0.97509423  0.0223419276  0.2702866854 -0.22572144 -0.02528925  0.19534428  0.88443516
y        0.95172220  0.0275720250  0.2635844027 -0.21761579 -0.02934067  0.18376015  0.86542090
z        0.95338738  0.0020373568  0.2682268757 -0.22426307  0.09492388  0.15092869  0.86124944
                  x           y            z
carat    0.97509423  0.95172220  0.953387381
cut      0.02234193  0.02757203  0.002037357
color    0.27028669  0.26358440  0.268226876
clarity -0.22572144 -0.21761579 -0.224263069
depth   -0.02528925 -0.02934067  0.094923882
table    0.19534428  0.18376015  0.150928692
price    0.88443516  0.86542090  0.861249444
x        1.00000000  0.97470148  0.970771799
y        0.97470148  1.00000000  0.952005716
z        0.97077180  0.95200572  1.000000000

##9 Decimal places is not ideal, drop it to 2.
corr <- round(cor(Diamonds),2)
##Show me the gram.
ggcorrplot(corr, method = "circle",  lab = TRUE, hc.order = TRUE)

###From this, the best correlation of price appears to be carat, so that is what I'll use. 

Split the data into train and test sets

##In order to check if the prediction works, we need to split the data into training data and test data. I'll split it about 75-25 to give a good amount to work with.
split <- sample.split(Diamonds,SplitRatio = 0.75)
train <- subset(Diamonds,split==TRUE)
test <- subset(Diamonds,split==FALSE)

Analyse the curve to best begin the linear prediciton model

plot(Diamonds$price, Diamonds$carat)

linearModel <- lm(price ~ carat, data = train)
plot(linearModel)

curve(predict(linearModel, data.frame(carat=x)), lwd = 2, col = "dodgerblue",  add=T)

Plot secondary graph to visualise prediction vs actual value

test$predicted.linear <- predict(linearModel, test)
pl1 <- test %>% 
    ggplot(aes(price,predicted.linear)) + 
    geom_point(alpha=0.5) + 
    stat_smooth() + 
    xlab('Actual value of diamond') + 
    ylab('Predicted value of diamond') + 
    theme_bw() 
ggplotly(pl1)

`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

Find Error based on linear model

error <- test$price-test$predicted.linear 
  rmse <- sqrt(mean(error^2)) 
  rmse 

[1] 1527.588

Plot both non-linear and linear models.

e <- exp(1)
linearModel <- lm(price ~ carat, data = train)
##nonLinearModel <- nls(price ~ 327.7013 + 804.2829*e^(1.450356*carat), train)
##nonLinearModel <- Vectorize(nls(price ~ (327.7013 + 804.2829*e^(+1.450356*x)), train, start = list(x = carat)))
nonLinearModel <- nls(price ~ e^(b*carat) + c, train, start = list(b = 2, c = 0))
plot(train$carat, train$price, col="Red", pch=16) 
##curve((327.7013 + 804.2829*e^(+1.450356*x)),lwd=3, col="dodgerblue", add = T)
curve(predict(linearModel, data.frame(carat=x)), lwd = 2, col = "dodgerblue",  add=T)

curve(predict(nonLinearModel, data.frame(carat=x)), lwd = 3, col = "black",  add=T)

test$predicted.nonlinear <- predict(nonLinearModel, test)
pl1 <- test %>% 
    ggplot(aes(price,predicted.nonlinear)) + 
    geom_point(alpha=0.5) + 
    stat_smooth() + 
    xlab('Actual value of price') + 
    ylab('Predicted value of price') + 
    theme_void() 
ggplotly(pl1)

`geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

Again like we did with the linear model we can calculate the RMSE. Then we can compare that with the AMSE from the linear model to see if any improvements have been made.

error <- test$price-test$predicted.nonlinear 
rmseNL <- sqrt(mean(error^2)) 
rmseNL 

[1] 3973.389

From this, we can see the linear model is more accurate than the non-linear one. I would argue however that the non-linear custom equation should theoretically be more accurate, yet I cannot figure out how to make that work. That will be a point for a future project. This can therefore be used on other data sets of similar making to attempt to estimate Diamond prices based on Carat.